C***** AIDS IN EXTRACTING PARTS FROM SCORES AND DOES AUTOMATIC PAGE LAYOUT. 
C***************************** THERE ARE STILL SEVERAL BUGS IN THIS PROG.
C***************************** TRANSPOSE-ONLY IS NOT FULLY TESTED.
C*********** TRANSPOSITION OF 'F' PARTS IN BASS CLEF HAS SOME PROBLEMS.
C***************************** ETC., ETC.    8/78

C SEE PAGE.CMD FOR LOADING INSTRUCTIONS
C **** SUBROUTINE LIST *****
C PAGE:  READX
C RESPC:
C RESTP:
C WRTPAG: 
C PGSUB: FILOUT(NAMQ,NPG), FILEIN, STAVES
C TRONLY: 
C TRNSP: TRNSP, RVRS
C PTMOVX: PTMOVE, TURN
C FNDTRN: MNMX, FNDTRN, BRJUGL, GET
C PFAIL: LOOKF,LOOKX,LOOK,SHFTQ,SORT2,NORH,FNDEND,MINMAX,RLOOP,BLTEM,IFIX,FLOAT
C	 GETPTS,MOVIT,EXTEN,DBAR,QRN,SORT,SHIFT,SHFT1,SHFT0,PSHFT,ADRST,STAFF
C        RIGHT,RESTS,EXCHG,EXCH,SHRNK,EXPND,CLFNUM,SLRV,CLEFN,MMNN,CODEN,ZERO 
C EXT:   PUTEXT,EXTOUT,GETEXT,EXTIN,FINEXT

	COMMON/STF/RSTFAC(0/7),RSTJ2 /POSI/STFF(0/7),JJ2,JPQ
	1 /IPG/IPG,JPG,BRACK(0/7),RSTNUM(8),RPSZ(8),RHGT(8),
	1 RCLEF(0/7) /RSIG/RSIG(0/7) /IVV/NRD(200)
	COMMON RS,JA,REST,J2,RQ(18),JX,PR,LX,RDIS
C  ORDER OF COMMON BLOCKS **MUST** STAY AS IS!
	COMMON/XRN/RN(3500) /SF/KL,RT,KP,STFSZ,NAMX,EXT
	1 /PTR/KWDS(350)/LLL/LLL,LL,I,IX,XSIG/XXX/LK,LP,JY /JN/J,N
C  INCREASE DIMENSION OF KWDS (KPN & Q) FOR VERY FULL PAGES.
      DIMENSION MM(1500),NN(1500),BARS(509),STFNM(0/7),KSAVE(30),
	1 RMETER(0/7),RCL(0/7),NUMS(30),PGTRN(500),SAVES(470),U(1)
C KSAVE AND SAVES ARE TO SAVE REHEARSAL NUMS, ETC. -- LIMIT=30
	COMMON /PX/KPN(450) /Q/Q(4000) /KBAR/KBAR(1027) /IRST/IRST
 	1 /RCLF/KK,CLEF,KW,ITEM,RSTAFF,SN,YN,RNAM,RNAM2,RNAM3
	1 /RSP/KNM(100) /ENDL/ENDLN,KQ,NAME,NMPG,SPCNT,LASTNM
	1 /JWDS/JWDS(300),RRN(3000)
C  JWDS IS EQUIVALENCED IN PTMOVX.F4 AND RESTP.F4
	DATA FIB/.7/,RSPC/25./,PGNUM/1.6/,RNMHT/16.0/,RNMSZ/1.0/
	1 ,RLTRSZ/1.0/,SPCPG/2.7/
	EQUIVALENCE (RQ(2),R4),(R5,RQ(3)),(R6,RQ(4)),(R7,RQ(5))
	1,(MM,RN),(NN,RN(1501)),(KS,RS),(BARS,KBAR(4)),(JRSTF,RSTJ2)
	1,(R8,RQ(6)),(R9,RQ(7)),(RQ(10),XLFT),(KBR,KBAR),(T,KBAR(2))
	1,(STFNM,KBAR(508)),(NUM1,NUMS,KPN),(PGTRN(1),KBAR(5 16))
	1,(SAVES,Q(3001)),(KSAVE,Q(3475)),(U,KBAR(1026))
C  HANDLES 503 PAGES AND PAGE-TURN INFO. IN KBAR AND PGTRN
C  RQ(2) IS R4, RQ(3) IS R5 ETC.  STAFF NAMES START AT KBAR(508)=STF(0)

	RN(2)=0
	EXT='MS'
	IRST=0
C IRST IS USED IN SUBROUTINE RESTP
	IPG=0
	KBR=0
	NMPG='PAGEA'
	JPG=0
	JRD=1
	ENDLN=0
	SAVSIZ=0
	ISN=0
	NCNT=10000
	IFOUND=0

	TYPE 1000   
	ACCEPT 2000,NAMX
	IF(NAMX.EQ.0)CALL PT2
	IF(NAMX.EQ.3)CALL TRONLY
	NPG=NAMX-2
	TYPE 3300
	IF(NPG.GE.0)GO TO 3000
CC	IF(NPG.GE.0)TYPE 3
	ACCEPT 2,KS,NTYPE
C  TYPE -1 AFTER NAME(I.E.5 SPACES) TO PRINT INST. NAMES AS READ.
CC	NAMZ=KS
	JNM=1

	CALL LO2UP(KS)
143	CALL IFILE(1,KS)
	READ(1,2)K
CC843	READ(1,2)K
	IF(K.NE.'COMME')GO TO 543
743	READ(1,643),K,K,K
C  READ ET DIRECTORY !∃∀ βλπα∀πεβα!ββX!
	IF(K.NE.';')GO TO 743
	READ(1,2)K
	GO TO 843
C  FIRST LINE MUST BE EXTENSION NAME
643	FORMAT(3A1)
2	FORMAT(A5,30I)
CC3	FORMAT(' TYPE FILE NAME.EXT -- '$)
3300	FORMAT(' TYPE FILE NAME -- '$)
1000	FORMAT(' 1=PARTS, 2=PAGE LAYOUT, 3=TRNSP ONLY, <CR>=OLD  '$)
2000	FORMAT(I)
CC543	READ(1,2,END=343),KNM(JNM),(KPN(K),K=1,30)
543	CALL IFILE(1,KS)
843	CALL READX(1,KNM(JNM),EXT,KEND,NUMS)
	IF(KEND)GO TO 343
	JNM=JNM+1
	DO 434 K=1,30
	J=KPN(K)
	JPG=JPG+1
	NRD(JPG)=J
C  BE CAREFUL ABOUT RUNNING OVER NRD ARRAY (100)-- ZEROS ARE INSERTED***********
434	IF(J.EQ.0)GO TO 843
	GO TO 843
CC3000	CALL NAMEXT     
3000	CALL READX(5,NAMX,EXT,KEND,NUMS)
	KNM(1)=NAMX
	GO TO 4000
343	KNM(JNM)=-1
	NXX=NRD(1)
C NXX COULD BE EQUIV. TO NRD(1)!!
4000	NAMZ=KNM(1)
	IF(NPG.GE.0.AND.NUM1.GT.0)NCNT=NUM1
C TYPE A # AFTER FILE NAME TO SET # OF FILES TO BE READ.
	DO 911 K=0,7
	RCLEF(K)=99
	RCL(K)=99
	RMETER(K)=99
C  INITS STUFF FOR PAGE LAYOUT
	BRACK(K)=0
911	RSIG(K)=99
	
744	XSIG=FIB
	QSIG=FIB
	CLEF=-1
	XMTR=FIB
	XLFT=0
	JPG=0
	YCLEF=2.
	YSIG=2.
	YMTR=2.
	RSTAFF=0
	RM=0
	JNM=1
CZ1344	JNM=1

1344	IF(NCNT.EQ.0)GO TO 1212
C NCNT IS INPUT FILE COUNTER.
	NCNT=NCNT-1
	ZLFT=.5
	KQ=0
	IF(NPG.EQ.0)JRD=0
	LLL=1
	LK=1
86	FORMAT(1XA5)
186	FORMAT(1XA5,'.',A3)

83	NAME=KNM(JNM)
CZ	JNM=JNM+1
	IF(NAME.EQ.-1)GO TO 1212
CC	JRD=JRD+1
CXCX	NXX=NRD(JRD+1)
CZ	NXX=NRD(JRD)
C?????????????	IF(KBR.EQ.0)GO TO 284
	JZ=-1
10	IF(LOOKX(NAME,EXT))GO TO 284
CZ100	IF(JZ)GO TO 344
C  FOUND NO MORE TO READ
344	NAME=NAMZ+256
C UPDATE 4TH CHAR.  (E.G. AAAAA TO AAABA)
	NAMZ=NAME
	KNM(JNM)=NAME
	IF(LOOKX(NAME,EXT))GO TO 284 
C NOW ALL DONE WITH INPUT, START OUTPUT
1212	CALL PUTEXT('BARS','PAG')
	RSTJ2=SAVSIZ
	DO 1213 K=0,75
1213	U(K)=RSTFAC(K)
C SAVE VARIOUS THINGS ON END OF KBAR ARRAY FOR USE IN OUTPUT SECTION.
	CALL EXTOUT(KBAR,1100)
CC	CALL EXTOUT(RSTFAC,128)
	CALL FINEXT
C K (NUM OF BARS - UP TO 511) IS FIRST LOC OF KBAR.
	CALL PT2(KPN,Q,KWDS,RN)

284	JZ=0
	SN=0
	IF(NPG)SN=200
	SNMTR=SN
	IF(RM.NE.0)GO TO 277
	RM=-1
4	FORMAT(' TYPE INST NAME  '$)
	IF(NPG.GE.0)GO TO 277     
	TYPE 4
	ACCEPT 2,RNAM,K
	CALL LO2UP(RNAM)
	RNAM2=-1
	RNAM3=-1
	RNAM4=-1
	IF(K.EQ.0)GO TO 277
	TYPE 177
	ACCEPT 2,RNAM2,K
	CALL LO2UP(RNAM2)
	IF(K.EQ.0)GO TO 277
C  TYPE NUM AFTER NAME TO ENTER UP TO 4 NAMES.
	TYPE 177
	ACCEPT 2,RNAM3
	CALL LO2UP(RNAM3)
	TYPE 177
	ACCEPT 2,RNAM4
	CALL LO2UP(RNAM4)
177	FORMAT(' OTHER INST NAME   ',$)


277	TYPE 186,NAME,EXT
C*** 	CALL GETEXT(NAME,EXT)
C*** C  LP IS START OF RN ARRAY THIS TIME
C*** 	CALL EXTIN(RSTFAC,20)
C*** 	CALL EXTIN(KWDS,JJ2)
C*** 	CALL EXTIN(RN,JPQ)
	CALL INMUS(NAME,EXT,RN,KWDS,RSTFAC)
C NEW SAVE FORMAT
	IF(JRSTF.LT.10000)RSTJ2=1.0
C X!Z+*↑: WHERE IS THE BUG THAT PUTS AN INTEGER INTO RSTJ2????
CZ	IF(SAVSIZ.EQ.0)SAVSIZ=RSTJ2
	IPG=NPG
C  IPG MUST BE RESET EACH TIME BECAUSE READIN WIPES IT OUT.

	CALL RLOOP(Q,RN,JPQ)
	ITEM=JJ2-2

1211	R=RN(KWDS(1)+2)
	K=2
	LS=1
	J=0
C  SORTS NOTES AND RHYTH ONLY
1111	KX=KWDS(K)
	RA=RN(KX+2)
	IF(RA.GE.R)GO TO 1011
	CALL EXCH(KWDS(K),KWDS(LS))
	J=-1
1011	R=RA
2611	LS=K
	K=K+1
	IF(K.LE.ITEM)GO TO 1111
	IF(J)GO TO 1211
C NOW ALL SORTED  (BY  STAFF)
	J=1
	KW=1

	DO 1311 K=1,ITEM
	LS=KWDS(K)
	IF(RN(LS+1).GT.2)GO TO 2711
	RN(LS+3)=RN(LS+3)-.001
C  MOVE ALL NOTES AND RESTS SLIGHTLY TO LEFT. (FOR SORTER)
2711	M=RN(LS)+3
	CALL RLOOP(Q(J),RN(LS),M)
	J=J+M
	KPN(K)=KW
1311	KW=KW+M  

	KPN(ITEM+1)=KW
CC	DO 1511 K=1,ITEM+1
CC1511	KWDS(K)=KPN(K)
CC	DO 1611 K=1,JPQ
CC1611	RN(K)=Q(K)
	CALL BLTEM
C  BLTEM BLTS ARRAYS KPN AND Q INTO KWDS AND RN

	DO 18 K=1,JPQ
18	Q(K)=0
C ZERO IT FOR FUTURE SAFETY

	JCUE=0
	RLFT=10000
811	DO 577 K=1,ITEM
	R=CODEN(KWDS,K,RN,J)
	IF(R.GT.2)GO TO 809
	IF(RLFT.GT.RN(J+3))RLFT=RN(J+3)
C RLFT IS LEFT-MOST NOTE OR REST.  USED FOR DISCARDING ENTERING SLURS.
	GO TO 577
809	IF(R.LT.4)GO TO 577
	RWD=RN(J)
C RWD IS WDCNT OF EACH ITEM
	JS=RN(J+2)
	IF(IPG.LT.0)GO TO 111
C IPG=-1 = EXTRACTING PARTS, =0  = PAGE LAYOUT.
	IF(R.NE.8)GO TO 211
	STFNM(JS)=0
	IF(RWD.GE.7)STFNM(JS)=RN(J+9)
C SAVES STAFF IDENT. NAME
1811	IF(ENDLN.NE.0)GO TO 577
	JPG=JPG+1
	LS=JS+1
	RSTNUM(LS)=JS
	RHGT(LS)=0
 	IF(RWD.GE.2)RHGT(LS)=RN(J+4)
	RPSZ(LS)=RSTFAC(JS)
	IF(SAVSIZ.EQ.0)SAVSIZ=RPSZ(LS)
	IF(R5.EQ.0)SPCNT=SPCPG*RPSZ(LS)
211	IF(R.NE.4)GO TO 577
	IF(RN(J+3).LT.RLFT)GO TO 311
CC	IF(RN(J+3).LT.ZLFT)GO TO 311
C ASSUMES NOTE OR REST HAS ALREADY BEEN SEEN. (ZLFT=P3+.5)
	IF(RN(J+2).NE.0)RN(J+1)=44
CC	IF(RN(J+2).EQ.0)GO TO 577
CC511	RN(J+1)=44
C  BARS NOT ON STAFF ZERO NOW HAVE CODE NUM. 44
	GO TO 577
311	IF(IPG.LT.0)GO TO 577
	IF(ENDLN.NE.0)GO TO 577
	IF(RWD.GE.5)BRACK(JS)=RN(J+7)+RN(J+4)*100.
C  SAVE 'BRACKET' INFO (P7=3,4 OR 5) - CAN FIND WRONG THING!!
	GO TO 577

111	IF(R.NE.8)GO TO 112
	IF(RWD.LT.7)GO TO 577
C  NO NAME ON THIS STAFF - SO JUMP
	IF(RN(J+7).NE.0)GO TO 577
C  SKIPS INVISIBLE STAVES.
	XLFT=RN(J+3) 
C LEFT LIMIT OF STAFF
	R9=RN(J+9)
	IF(NTYPE.LT.0)TYPE 86,R9
	IF(R9.EQ.RNAM)GO TO 977
	IF(RNAM2.EQ.R9)GO TO 977
	IF(RNAM3.EQ.R9)GO TO 977
	IF(RNAM4.NE.R9)GO TO 577
977	TYPE 1577,R9,NAME
	IF(SN.NE.200.)PAUSE ' **** SAME NAME FOUND AGAIN ****'
	I=JS+RSTAFF
	SN=I
	SNMTR=SN
	IFOUND=-1
C FLAG TO SAVE RN AND KWDS ARRAYS
	RPSZ(1)=RSTFAC(JS)
	IF(SAVSIZ.EQ.0)SAVSIZ=RPSZ(1)
C  SO IT WON'T LOOK ON MORE STAVES IN OTHER FILES.
CZ	IF(NXX.GT.1)NXX=-NXX
C THIS TAKEN OUT 3/7/80 BECAUSE DIDN'T FIND WORDS IN LOWER FILES.
	JCUE=-1
CCC	IF(IPG.LT.0)TYPE 1577,R9,NAME
C WE ONLY GET WHEN EXTRACTING PARTS.
	GO TO 577
1577	FORMAT(1XA5,' FOUND IN ',A5)
CXXX	GO TO 477
112	IF(IPG.GE.0)GO TO 577
	IF(R.NE.16)GO TO 113
	IF(RN(J+5).LT.100)GO TO 577
	GO TO 1113
113	IF(R.NE.10)GO TO 577
C  SKIPS PAGE NUMS. (I.E. P7 > 2)
	IF(RN(J+6).LT.100)GO TO 577
C SAVE NUMBER IF SIZE FACTOR(R6) IS +100 (JUST LIKE CODE 16)
C????******ALL THIS TO 800-1 CAN NOW BE TAKEN OUT.  USE P6+100 FOR REHRSL. #S.
	RN(J+4)=RNMHT
	RN(J+6)=RNMSZ
C  THE ABOVE SET HEIGHT AND SIZE OF REHEARSAL NUMS.
1113	RN(J+2)=0
C PARTS ARE ALWAYS ON STAFF 0
CX	JS=J
	JJK=RWD+2+LK
CX	DO 1112 JJJ=LK,JJK
CX    	SAVES(JJJ)=RN(JS)
CX1112	JS=JS+1
	I=JJK-LK+1
	CALL RLOOP(SAVES(LK),RN(J),I)
C PUTS RN INTO SAVES
	LK=JJK+1
	RN(J+2)=10.
	LLL=LLL+1
	KSAVE(LLL)=LK
577	CONTINUE
C  DIDN'T FIND USEFUL INFO SO SKIP THIS FILE
CX	IF(JCUE)GO TO 477
CCC	IF(IPG)TYPE 1577,RNAM,NAME
477	I=JPQ-2
C READS AND WRITES 1 EXTRA WORD
	IF(IPG.EQ.0)GO TO 13

	IF(IFOUND.GE.0)GO TO 877
	IFOUND=-IFOUND
	JTEM=ITEM+1
	DO 1877 K=1,JTEM
1877	JWDS(K)=KWDS(K)
	DO 2877 K=1,KWDS(JTEM)
2877	RRN(K)=RN(K)
C NOW DATA FOR THIS INST. IS SAVED.

CZ	IF(NXX.GT.0)GO TO 877
C NEXT FOR PARTS ONLY.  TO SKIP A FILE (OR MORE)
CZ	NAME=NAME-2*(NXX+1)
CZ	NXX=1
877	NXX=NXX-1
	KNM(JNM)=NAME
	NAME=NAME+2
	IF(NXX.NE.0)GO TO 277
	JRD=JRD+1
	NXX=NRD(JRD)
	IF(NXX.NE.0)GO TO 44
	JNM=JNM+1
	NAMZ=KNM(JNM)
	KNM(JNM)=NAMZ-2
C KNM GETS BACK +2 AT RETURN FROM RESPC.
	JRD=JRD+1
	NXX=NRD(JRD)
CZ	NAME=0
CZ	NAMZ=0
44	RSTAFF=0
13	YN=0
	IF(SN.NE.200)GO TO 8
	YN=-1
	IF(YCLEF.GT.1)YCLEF=-1
	IF(YSIG.GT.1)YSIG=-1
	IF(YMTR.GT.1)YMTR=-1

8	ZLFT=XLFT+.5
	RNUM=PGNUM
C  SIZE FACTOR FOR PAGE NUMBER FINDER (MAYBE).
	QLFT=RLFT
C SAVE IN QLFT FOR 1ST BAR OF LINE CHECK.
	RLFT=RLFT-3
C TO CATCH 1ST SLURS.
	JCUE=0

C****	IF(LK.EQ.1)GO TO 2112
	IF(LK.EQ.1)GO TO 2113
CX	DO 3112 K=1,LK    
CX3112	Q(K)=SAVES(K)
	CALL RLOOP(Q,SAVES,LK)
C PUTS SAVED THINGS INTO Q ARRAY AND POINTER ARRAY (KPN)
CX	DO 4112 K=2,LLL
CX4112	KPN(K)=KSAVE(K)
	CALL RLOOP(KPN,KSAVE,LLL)
	KPN(1)=1
2113	IF(IPG.EQ.0)GO TO 2112
	IF(IFOUND.EQ.0)GO TO 2112
	IFOUND=0
	DO 183 K=1,JTEM
183	KWDS(K)=JWDS(K)
	DO 283 K=1,KWDS(JTEM)
283	RN(K)=RRN(K)
	ITEM=JTEM-1
C NOW GOT BACK DATA FOR SINGLE INST.

C THIS SECTION COLLECTS ALL ITEMS TO USED LATER(NOT EVERYTHING IF 'PARTS')
2112	DO 6 K=1,ITEM
	R5=-1
	R=CODEN(KWDS,K,RN,J)
	IF(R.EQ.0)GO TO 6
C  DUPLICATE BARS WERE CHANGED TO CODE 0
	RWD=RN(J)
C RWD IS WDCNT OF EACH ITEM
800	IF(R.NE.4)GO TO 80
	IF(RN(J+4).GE.1000)GO TO 801
C FINDS DBL BARS OF ALL SORTS
	IF(RWD.GT.2)GO TO 182
C  FOUND A BAR LINE
CC801	IF(RN(J+3).LT.ZLFT)GO TO 6
801	IF(RN(J+3).LT.QLFT)GO TO 6
CC801	IF(RN(J+3).LT.RLFT)GO TO 6
C DROPS BAR LINE TO LEFT OF FIRST NOTE OR REST.
	IF(IPG.EQ.0)GO TO 382 
	IF(RWD.LT.2)GO TO 382
	LL=RN(J+4)/100.
	RR=100*LL+1.0
	RN(J+4)=RR
C THIS PRESERVES DOUBLE BARS OF ALL SORTS.
CCC	IF(RN(J+2).NE.0)GO TO 182
C  KEEP BAR LINES ON STAVES >0 BUT DON'T COUNT THEM.
382	CALL DBAR(K,ITEM,J)
	IF(YN.EQ.0)GO TO 810
	CALL ADRST(KPN,RR)
	GO TO 6
182	RN(J+1)=44
C  CHANGES CODE NUM 
	IF(IPG.EQ.0)GO TO 482
	IF(RN(J+5).EQ.150)RN(J+2)=SN
C P5=150=PUT CRESC-DECRESC. IN ALL PARTS (WHEN IN PARTS MODE [IPG=-1])
482	IF(RWD.LT.5)GO TO 80
	IF(RN(J+7).GE.3)GO TO 6
C  SKIP HEAVY BRACKETS.
	IF(RWD.LT.4)GO TO 80
	A=RN(J+6)
	IF(A.EQ.0)GO TO 80
	IF(A.GE.199)RN(J+6)=200

80	IF(R.NE.16)GO TO 180
	IF(RWD.LT.8)GO TO 280
	IF(RN(J+10).EQ.1)RN(J+3)=RN(KWDS(K-1)+3)
C PUT CONTINUATION OF TEXT IN SAME POS. AS 1ST UNIT OF TEXT.
280	IF(IPG.EQ.0)GO TO 180
	IF(RN(J+5).GE.100)RN(J+2)=SN
C CATCHES WANTED TEXT ON OTHER LINES.  (P5>100)
CXXX 	IF(RN(J+5).GT.RLTRSZ)RN(J+5)=RLTRSZ
C  LIMITS SIZE OF LETTERS.  ADJUST RLTRSZ TO SUIT. (SET AT 1.0 NOW)

180	RSN=RN(J+2)
	IF(IPG.LT.0)GO TO 2011
	ISN=RSN
	RSN=SN
C  THE STAFF NUM.

2011	IF(R.NE.3)GO TO 3801
	IF(IPG.LT.0)GO TO 2111
	CLEF=RCL(ISN)
	GO TO 4801
2111	IF(RN(J+6).LT.100)GO TO 4804
	RN(J+2)=SN
C SIZE +100 (R6) IS PUT IN ALL PARTS (FOR P,PP,PPP,MF, ETC.)
	GO TO 4803
4804	IF(YCLEF)GO TO 4801
	IF(RSN.NE.SN)GO TO 6
4801	RR=CLEFN(RN,J)
C  GET CLEF NUMBER.
	IF(RR.EQ.CLEF)GO TO 6
C SKIP DUPLICATE CLEFS.
	IF(RR.GT.4)GO TO 4800
C 0=TREB 1=BASS 2=ALTO 3=TENOR 4=PERCUSSION CLEF.
	IF(IPG.LT.0)GO TO 17
	RCL(ISN)=RR
	IF(RCLEF(ISN).EQ.99)RCLEF(ISN)=RR
C  SAVE FIRST CLEF ON EACH STAFF
	GO TO 1800
CP16	FORMAT(' CLEF=',F2.0,' --CHANGE TO--',$)
CP	TYPE 16,RR
CP	ACCEPT 5,RR
17 	R5=RR
	CLEF=RR
	YCLEF=0
	GO TO 1800
4800	IF(RSN.NE.SN)GO TO 6
4803	RN(J+1)=33
	GO TO 1800
4802	YCLEF=0
C  CATCHES CLEF AFTER FIRST RESTS.
	GO TO 6

3801	IF(R.NE.17)GO TO 3800
	RR=RN(J+5)
	IF(IPG.GE.0)GO TO 3803
	IF(RSN.NE.SN)GO TO 6
C FOR PARTS:  SKIP IF NOT ON RIGHT STAFF.
	IF(QSIG.EQ.RR)GO TO 6
C FOR PARTS:  IF SAME KEY SIG. THEN OMIT IT.
	QSIG=RR
	GO TO 3804
3803	IF(RR.EQ.RSIG(ISN))GO TO 6
C SKIPS DUPL. KEY SIGS. 
C***** WHAT ABOUT CHANGING KEY SIGS?????
CC	YSIG=0
3804	IF(RSIG(ISN).EQ.99)RSIG(ISN)=RR
C SETS UP KSIG ONCE ONLY.
	GO TO 1800

3800	IF(R.EQ.8)GO TO 6
C  OMIT ALL STAVES FOR NOW
	IF(R.NE.18.)GO TO 81
CP	IF(IPG)GO TO 2311
	XMTR=RMETER(ISN)
	GO TO 1801
2311	IF(YMTR)GO TO 1801
	IF(SNMTR.EQ.200.)SNMTR=RSN
C  SO IT WON'T REPEAT METERS.
C  CHECK ALL METERS IF LINE HAS NOT THIS INST.
	IF(RSN.NE.SNMTR)GO TO 6
1801	RA=TSIG(RN,J)
C  THE TIME SIG.
	IF(XMTR.EQ.RA)GO TO 6
	XSIG=RA
	XMTR=RA
	YMTR=0
	IF(IPG.LT.0)GO TO 181
	RMETER(ISN)=RA
	GO TO 1800
181	RR=RN(J+3)
	DO 281 LS=1,LLL-1
	IF(CODEN(KPN,LS,Q,KW).NE.R)GO TO 281
C LOOK FOR SAME  METER CLOSE TO  SAME POS. (DIF. METER WILL OVERPRINT)
	IF(XSIG.NE.TSIG(Q,KW))GO TO 281
	IF(ABS(Q(KW+3)-RR).LT.0.5)GO TO 6
281	CONTINUE
	GO TO 1800

81	IF(RSN.NE.SN)GO TO 6
1800	IF(IPG.EQ.0)GO TO 5800
	IF(RN(J+3).LT.XLFT)GO TO 6
C OMIT SOME THINGS TO LEFT OF STAFF BEGINNING.
	GO TO 6800
5800	IF(R.NE.7)GO TO 282
6800	IF(R.LT.4)GO TO 810
	IF(R.EQ.44)GO TO 6801
	IF(R.GT.7)GO TO 810
C  NEXT FOR ITEMS WHERE P6 MAY GO PAST 200.
	IF(RWD.LT.5)GO TO 810
6801	A=ABS(RN(J+7))
	IF(A.LT.2.OR.A.GT.7)GO TO 82
C  CATCHES TRILL WIGGLE OVER END OF LINE.
282	IF(R.NE.5)GO TO 810
	IF(RN(J+3).LT.RLFT)GO TO 6
C OMIT ENTERING SLURS.   NEXT CHECKS FOR SLUR OVER END OF LINE
82	IF(RN(J+6).GE.199.)RN(J+6)=200.
C  ****** 200.0 ABOVE IS SUBJECT TO CHANGE!
810	KL=0
CC	IF(R.GT.2)GO TO 1810
	IF(R.EQ.1)GO TO 2810
	IF(R.NE.2)GO TO 1810
	IF(IPG.GE.0)GO TO 2810
	IF(RWD.LT.8)GO TO 2810
C NEXT FOR FINDING CUES WHEN IN PARTS MODE.  FINALLY GETS LAST NEEDED POINTER.
	IF(RN(J+10).GE.0)JCUE=K
C NEXTS FINDS NOTES AND RESTS WITHOUT RHYTHM (P7 OR P9)
2810	IF(RN(J+3)-PQ.GT.SPCPG)GO TO 1810
C  JUMP IF NOT IN SAME VERT. POS.
	IF(RT.NE.R)GO TO 1810
C JUMP IF PREVIOUS ITEM WASN'T THE SAME
CC	IF(RN(J+9).NE.4.0/88.0)GO TO 3810
C JUMP IF NOT A GRACE NOTE
CC	R=0
C R=0 SO THAT GRACE NOTE WILL NEVER BE TOO CLOSE TO REG. NOTE.
CC	GO TO 1810
3810	RS=9-R*2
	IF(RWD.GE.RS)GO TO 1810
C JUMP IF WDCNT IS BIG ENOUGH
	KL=RS-RWD
C  SEND THE DIFFERENCE TO THE SUBROUTINE AND ADD A RHYTHM (1.0)
1810	IF(IPG.LT.0)RN(J+2)=0
C  ALWAYS SET STAFF NUM TO 0 FOR PARTS.
	CALL QRN(J,KPN,K)
C  PUTS NEEDED THINGS INTO Q ARRAY
	RT=R
	PQ=RN(J+3)
C SAVE THINGS FOR NEXT TIME AROUND LOOP.
6	CONTINUE

	IF(JCUE.NE.0)CALL CUES

C******↓↓↓↓↓↓ RHYTH RESET ↓↓↓↓↓↓↓↓
	CALL SORT(KPN)
C   SORTS Q ARRAY, PUTS IT BACK INTO RN
23	LL=0
C  TO 'MOVE' INSTEAD OF 'JUSTIFY'
CC	J=1
CC223	R=CODEN(KWDS,J,RN,K)
CC	IF(R.LE.3.OR.R.EQ.17.OR.R.EQ.18)GO TO 123
CC	J=J+1
CC	GO TO 223
CC123	R8=ENDLN-RN(K+3)+2
CC	R4=0
CC	R7=0
CC	RS=0
CC	R9=0
CC	R5=10000
C  INSERT??  →→ IF(R8.GT.0)R9=200.
CC33	CALL PTMOVE(RN,KWDS)
C******* IS KQ SUPPOSED TO BE 0!!!!!!!!?????
	CALL SHFT0(KQ)
20	CALL RESPC
	KNM(JNM)=KNM(JNM)+2
C UPDATE THE FILE NAME
	GO TO 1344
	END

	SUBROUTINE READX(IDEV,NAME,IEXT,KEND,NUMS)
	COMMON /PTR/INP(72)
	DIMENSION FORM2(5),FORMT(5),NUMS(30)
	DATA FORMT(1)/'('/,FORM2/'A1,','A2,','A3,','A4,','A5,'/
	1, FORM3/'30I)'/
1	FORMAT(72A1)
CC	IEXT='MS'
CC	ACCEPT 1,INP
	KEND=0
C IDEV=DEVICE NUMBER (1=DSK, 5=TTY)
	READ(IDEV,1,END=12)INP
	DO 2 K=2,72
	IF(INP(K).EQ.' ')GO TO 3
2	IF(INP(K).EQ.'.')GO TO 4
3	FORMT(3)=FORM3
	FORMT(4)=' '
	FORMT(5)=' '
5	FORMT(2)=FORM2(K-1)
	REREAD FORMT,NAME,NUMS
	GO TO 10
4	FORMT(3)=FORM2(1)
C  CATCHES DOT
	DO 7 N=K+1,72
7	IF(INP(N).EQ.' ')GO TO 8
8	FORMT(4)=FORM2(N-K-1)
	FORMT(5)=FORM3
	FORMT(2)=FORM2(K-1)
	REREAD FORMT,NAME,K,IEXT,NUMS
	CALL LO2UP(IEXT)
10	CALL LO2UP(NAME)
	RETURN
12	KEND=-1
	END

	SUBROUTINE LO2UP(J)
C CONVERTS ALL LOWER CASE TO UPPER CASE.
	J=J.AND..NOT.((J/2).AND."201004020100)
	END

	FUNCTION TSIG(Q,J)
	DIMENSION Q(1)
	TSIG=IFIX(Q(J+5)*100.0+Q(J+6)+.5)
C COMBINES METER NUMS.  (2/4 = 204. ETC.)
	END